home *** CD-ROM | disk | FTP | other *** search
/ PC-Blue - MS DOS Public Domain Library / PC-Blue MS-DOS Public Domain Library - NYACC.iso / vol081 / design.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1987-01-14  |  13.3 KB  |  470 lines
  1. 0  ' == D E S I G N . B A S == Version 2.0
  2. 1  ' Graphic formulas from Bob Boothe, from 80-Microcomputing, April-June 1981,      and TRSColor Computer routines from Jake Commander and Kavlos Gesamte, in       80-Micro, March 1982.
  3. 2  ' IBM PC conversions and modifications by Marty Smith. Houston, Texas.            (713) 661-1241  (Office)
  4. 3  ' SOURCE ST2259, COMPUSERVE 72155,1214.
  5. 4  ' This program requires BASICA, the Color Board, 64K and up, should work with     any  color display. My system has both boards and exiting through <M> or        <ALT X> makes <F7> a toggle between Color and B/W.
  6. 5  ' The <ALT X> exit leaves a design on the Color Screen and puts you in Command    Mode on Monochrome.
  7. 6  ' Originally the Function Keys called up elaborate designs that took too long     to generate on the screen. (One took the PC 2 1/2 hours). These were saved      in 16K BLOAD screens, which pretty much filled a whole disk.
  8. 7  ' That's what the BEEP's from function keys 1-8 are. This also keeps you from     inputting text strings to the program, while leaving them intact at command     mode.
  9. 25  GOSUB 8000
  10. 30  PI=3.14159
  11. 40  GOSUB 10000
  12. 45  IF ALT=1 THEN GOSUB 1601 ELSE GOSUB 1600
  13. 46  N=VAL(I$):IF I$="m" OR I$="M" THEN KEY 7,"gosub 65000"+CHR$(13):END
  14. 50  IF I$="0" THEN N=10 ELSE IF I$="c" OR I$="C" THEN GOSUB 20000
  15. 52  IF I$=CHR$(45) OR I$=CHR$(95) THEN N=11 ELSE IF I$="=" THEN N=12
  16. 53  IF I$="q" OR I$="Q" THEN M=1:GOTO 5810 ELSE IF I$="w" OR I$="W" THEN M=2:GOTO 5810 ELSE IF I$="e" OR I$="E" THEN M=3:GOTO 5810 ELSE IF I$="r" OR I$="R" THEN M=4:GOTO 5810 ELSE IF I$="t" OR I$="T" THEN M=5:GOTO 5810
  17. 54  IF I$="y" OR I$="Y" THEN M=6:GOTO 5810 ELSE IF I$="u" OR I$="U" THEN M=7:GOTO 5810 ELSE IF I$="i" OR I$="I" THEN M=8:GOTO 5810
  18. 55  ON N GOTO 110,210,320,400,500,700,850,1000,1200,1400,5000,5800
  19. 60  GOTO 40
  20. 100  REM design #5, Circle and circle
  21. 110  CLS:FOR T=0 TO 2*PI STEP PI/50
  22. 120  X1=COS(T)*160+159:Y1=SIN(T)*100+99
  23. 130  A=T+3*PI/4
  24. 140  X2=COS(A)*160+159:Y2=SIN(A)*100+99
  25. 150  GOSUB 1500
  26. 160  NEXT
  27. 170  GOSUB 1600
  28. 180  IF I$="x" THEN 40 ELSE IF I$=" " THEN 110 ELSE IF I$="0" THEN N=10:GOTO 50
  29. 200  N=VAL(I$):IF N>=0 AND N<16 THEN 50 ELSE 110
  30. 210  REM design #3, Moire Pattern
  31. 215  CLS:FOR T=0 TO PI/2 STEP PI/180
  32. 220  X1=FIX(COS(T)*100):Y1=SIN(T)*50
  33. 230  X2=FIX(COS(T)*320):Y2=SIN(T)*199
  34. 240  CO3=1:GOSUB 1500
  35. 250  X1=319-X1:Y1=199-Y1
  36. 260  X2=319-X2:Y2=199-Y2
  37. 270  CO3=2:GOSUB 1500
  38. 280  NEXT
  39. 300  GOSUB 1600
  40. 305  IF I$="x" THEN 40 ELSE IF I$=" " THEN 210 ELSE IF I$="0" THEN N=10:GOTO 50
  41. 310  N=VAL(I$):IF N>=0 AND N<13 THEN 50 ELSE 210
  42. 320  CLS:FOR T=0 TO 10*PI STEP PI/20:REM design 6, Spiral
  43. 330  X1=COS(T)*3.5*T+160:Y1=SIN(T)*3.5*T+100
  44. 340  A=T+2*PI/3
  45. 350  X2=COS(A)*3.5*A+160:Y2=SIN(A)*3.5*A+100
  46. 360  GOSUB 1500
  47. 370  NEXT
  48. 380  GOSUB 1600
  49. 390  IF I$="x" THEN 40 ELSE IF I$=" " THEN 320 ELSE IF I$="0" THEN N=10:GOTO 50
  50. 395  N=VAL(I$):IF N>=0 AND N<13 THEN 50 ELSE 320
  51. 400  CLS: FOR T=0 TO 2*PI STEP PI/60:REM design #8, Rotating Squares
  52. 410  R=COS(2*T)*100
  53. 420  X1=COS(T)*R+160:Y1=SIN(T)*R+100
  54. 430  A=T+PI/2
  55. 440  R2=COS(2*A)*100
  56. 450  X2=COS(A)*R2+160:Y2=SIN(A)*R2+100
  57. 460  GOSUB 1500
  58. 470  NEXT
  59. 480  GOSUB 1600
  60. 490  IF I$="x" THEN 40 ELSE IF I$=" " THEN 400 ELSE IF I$="0" THEN N=10:GOTO 50
  61. 495  N=VAL(I$):IF N>=0 AND N<13 THEN 50 ELSE 400
  62. 500  REM design #1, N-Sided Polygon
  63. 505  Z=0
  64. 510  PRINT"Number of points? (Maximum 48) "
  65. 515  FOR X=0 TO 10000:NEXT
  66. 516  I$=INKEY$:J$=INKEY$:I$=I$+J$:N=VAL(I$)
  67. 517  IF N=0 THEN N=CO1+10
  68. 518  IF N>48 THEN 510
  69. 519  CLS
  70. 520  FOR T=0 TO 2*PI-0.000999999 STEP 2*PI/N
  71. 530  Z=Z+1
  72. 540  A(Z)=COS(T)*159+159:B(Z)=SIN(T)*99+99
  73. 550  NEXT
  74. 560  FOR S=1 TO N-1:FOR D=S+1 TO N
  75. 570  X1=A(S):Y1=B(S)
  76. 580  X2=A(D):Y2=B(D)
  77. 590  GOSUB 1500
  78. 600  NEXT:NEXT
  79. 650  GOSUB 1600:IF I$="x" THEN 40 ELSE IF I$=" " THEN 500 ELSE IF I$="0" THEN N=10:GOTO 50
  80. 660  N=VAL(I$):IF N>=0 AND N<13 THEN 50 ELSE 500
  81. 700  CLS:REM design #4, Square Spiral
  82. 710  X1=200:Y1=120
  83. 720  FOR Q=1 TO 40
  84. 730  X2=X1+5*Q+2:Y2=Y1
  85. 740  CO3=1:GOSUB 1500
  86. 750  X1=X2:Y1=Y2+5*Q+3
  87. 760  CO3=2:GOSUB 1500
  88. 770  X2=X1-5*Q-5:Y2=Y1
  89. 780  CO3=3:GOSUB 1500
  90. 790  X1=X2:Y1=Y2-5*Q-6
  91. 800  CO3=2:GOSUB 1500
  92. 810  NEXT
  93. 820  GOSUB 1600
  94. 830  IF I$="x" THEN 40 ELSE IF I$=" " THEN 700 ELSE IF I$="0" THEN N=10:GOTO 50
  95. 840  N=VAL(I$):IF N>=0 AND N<13 THEN 50 ELSE 700
  96. 850  CLS:REM design# 7, Four Leaf Rose
  97. 860  FOR T=0 TO 2*PI STEP PI/75
  98. 870  R=COS(2*T)*100
  99. 880  X1=COS(T)*R+159:Y1=SIN(T)*R+99
  100. 890  A=T+PI/3
  101. 900  R2=COS(2*A)*100
  102. 910  X2=COS(A)*R2+159:Y2=SIN(A)*R2+99
  103. 920  GOSUB 1500
  104. 930  NEXT
  105. 940  GOSUB 1600
  106. 950  IF I$="x" THEN 40 ELSE IF I$=" " THEN 850 ELSE IF I$="0" THEN N=10:GOTO 50
  107. 960  N=VAL(I$):IF N>=0 AND N<13 THEN 50 ELSE 850
  108. 1000  CLS:REM design #10, Triangle Spiral
  109. 1010  FOR T=0 TO 2*PI STEP PI/30
  110. 1020  R=T*23
  111. 1030  X1=COS(T)*R+159:Y1=SIN(T)*R+99
  112. 1040  A=T+2*PI/3
  113. 1050  X2=COS(A)*R+159:Y2=SIN(A)*R+99
  114. 1060  GOSUB 1500
  115. 1070  B=T+4*PI/3
  116. 1080  X1=COS(B)*R+159:Y1=SIN(B)*R+99
  117. 1090  GOSUB 1500
  118. 1100  X2=COS(T)*R+159:Y2=SIN(T)*R+99
  119. 1110  GOSUB 1500
  120. 1120  NEXT
  121. 1130  GOSUB 1600
  122. 1140  IF I$="x" THEN 40 ELSE IF I$=" " THEN 1000 ELSE IF I$="0" THEN N=10:GOTO 50
  123. 1150  N=VAL(I$):IF N>=0 AND N<13 THEN 50 ELSE 1000
  124. 1200  REM design #11, Triangles in triangles
  125. 1210  R=1
  126. 1220  FOR T=0 TO 3.24 STEP PI/30
  127. 1230  R=R*1.16557
  128. 1240  X1=COS(T)*R+159:Y1=SIN(T)*R+99
  129. 1250  A=T+2*PI/3
  130. 1260  X2=COS(A)*R+159:Y2=SIN(A)*R+99
  131. 1270  CO3=1:GOSUB 1500
  132. 1280  B=T+4*PI/3
  133. 1290  X1=COS(B)*R+159:Y1=SIN(B)*R+99
  134. 1300  CO3=2:GOSUB 1500
  135. 1310  X2=COS(T)*R+159:Y2=SIN(T)*R+99
  136. 1320  CO3=3:GOSUB 1500
  137. 1330  NEXT
  138. 1340  CO3=2:GOSUB 1600
  139. 1350  IF I$="x" THEN 40 ELSE IF I$=" " THEN 1200 ELSE IF I$="0" THEN N=10:GOTO 50
  140. 1360  N=VAL(I$):IF N>=0 AND N<13 THEN 50 ELSE 1200
  141. 1400  Z=0:REM design # 2
  142. 1405  FOR Q=0 TO 319 STEP 9
  143. 1410  CO3=1:X1=0:Y1=Q*0.625:X2=Q:Y2=199
  144. 1415  GOSUB 1500
  145. 1420  CO3=2:X1=Q:Y1=0:X2=319:Y2=Q*0.625
  146. 1425  GOSUB 1500
  147. 1430  NEXT
  148. 1435  N=15
  149. 1440  FOR T=0 TO 2*PI -0.000999999 STEP 2*PI/N
  150. 1445  Z=Z+1
  151. 1450  A(Z)=COS(T)*100+159:B(Z)=SIN(T)*65+99
  152. 1455  NEXT
  153. 1460  FOR S=1 TO N-1:FOR D=S+1 TO N
  154. 1465  X1=A(S):Y1=B(S)
  155. 1470  X2=A(D):Y2=B(D)
  156. 1475  CO3=3:GOSUB 1500
  157. 1477  NEXT:NEXT
  158. 1480  GOSUB 1600
  159. 1490  IF I$="x" THEN 40 ELSE IF I$=" " THEN 1400 ELSE IF I$="0" THEN N=10: GOTO 50
  160. 1495  N=VAL(I$):IF N>=0 AND N < 13 THEN 50 ELSE 1400
  161. 1500  LINE(X1,Y1)-(X2,Y2),CO3
  162. 1510  RETURN
  163. 1600  I$="":DEF SEG:IF ALT=1 THEN 3600: ' DELAY/COLOR/SELECTION ROUTINE
  164. 1601  FOR Z=0 TO 3000
  165. 1602  I$=INKEY$:IF I$<>"" THEN Z=3000
  166. 1603  NEXT:Z=FRE(X$)
  167. 1604  IF I$="" THEN N1=CO1 MOD 16:I$ = STR$(N1)
  168. 1605  GOSUB 2000
  169. 1607  IF CO1 MOD 2 = 0 THEN CO2 = 1 ELSE IF CO1 MOD 2 = 1 THEN CO2 = 0
  170. 1608  IF LEN(I$)=2 THEN GOSUB 1640
  171. 1610  CLS:SCREEN 1,0:COLOR CO1,CO2:OUT 980,2:OUT 981,HSYNC%
  172. 1620  RETURN
  173. 1640  IF ASC(RIGHT$(I$,1))=45 THEN GOSUB 65000:END
  174. 1645  IF ASC(RIGHT$(I$,1))=30 THEN IF ALT=0 THEN ALT=1:GOSUB 4100 ELSE IF ALT=1 THEN ALT=0:GOSUB 4200
  175. 1650  RETURN
  176. 2000  CO1=RND(RNDGEN):CO2=RND(RNDGEN+1):CO3=RND(RNDGEN+3)
  177. 2005  CO2=CO2*100 MOD 2
  178. 2010  CO1=CO1*100 MOD 16
  179. 2040  CO3=CO3*100 MOD 3 + 1
  180. 2100  RETURN
  181. 3000  REM ///// F10 COLOR CHANGE ROUTINE \\\\\
  182. 3005  I$=""
  183. 3020  FOR XIT=0 TO 3000
  184. 3030  I$=INKEY$:IF I$ <> "" THEN XIT=3000
  185. 3040  NEXT XIT
  186. 3050  IF I$="b" OR I$="B" THEN CO1=0 ELSE IF I$="u" OR I$="U" THEN CO1=1 ELSE IF I$="g" OR I$="G" THEN CO1=2 ELSE IF I$="c" OR I$="C" THEN CO1=3 ELSE IF I$="r" OR I$="R" THEN CO1=4
  187. 3055  IF I$="m" OR I$="M" THEN CO1=5 ELSE IF I$="n" OR I$="N" THEN CO1=6 ELSE IF I$="w" OR I$="W" THEN CO1=7
  188. 3060  IF I$="s" OR I$="S" THEN CO1=9 ELSE IF I$="y" OR I$="Y" THEN CO1=14 ELSE IF I$="h" OR I$="H" THEN CO1=15
  189. 3065  IF I$="0" THEN CO2=0 ELSE IF I$="1" THEN CO3=1 ELSE IF I$="2" THEN CO3=2 ELSE IF I$="3" THEN CO3=3 ELSE IF I$="9" THEN CO2=1
  190. 3070  COLOR CO1,CO2
  191. 3100  RETURN
  192. 3600  REM alternate non-auto
  193. 3610  Z=0
  194. 3620  FOR Z1= 0 TO 100
  195. 3625  I$=INKEY$
  196. 3630  NEXT Z1
  197. 3632  ZAP=FRE(X$)
  198. 3635  IF Z=0 THEN 3620
  199. 3636  I$="x"
  200. 3640  GOTO 1604
  201. 3700  REM toggle non-auto
  202. 3710  BEEP
  203. 3720  Z=1
  204. 3730  SOUND 500,2
  205. 3740  RETURN
  206. 3800  I$="":DEF SEG:IF ALT=1 THEN 3600
  207. 3801  FOR ZINT=0 TO 3000
  208. 3802  I$=INKEY$:IF I$<>"" THEN ZINT=3000
  209. 3803  NEXT:ZAP=FRE(X$)
  210. 3810  GOTO 1604
  211. 3900  REM clear input buffer
  212. 3910  DEF SEG=&H40:BEGIN%=PEEK(&H1A):POKE &H1C,BEGIN%
  213. 3920  BEEP
  214. 3930  RETURN
  215. 4000  REM Dummy keys
  216. 4010  PLAY "MBXO$;"
  217. 4020  RETURN
  218. 4100  REM play my bonnie to indicate change of state
  219. 4110  PLAY "MBXM$;"
  220. 4120  RETURN
  221. 4200  REM more music
  222. 4210  PLAY "MBXN$;"
  223. 4220  RETURN
  224. 4300  REM
  225. 4310  PLAY "MBXP$;"
  226. 4320  RETURN
  227. 5000  A=31:FOR DO3%=1 TO 2
  228. 5010  Z=VAL(RIGHT$(TIME$,2))
  229. 5020  Z%=VAL(RIGHT$(TIME$,2))
  230. 5030  GOSUB 2000:COLOR CO1,CO2
  231. 5040  FOR N=10 TO 1 STEP -2
  232. 5050  FOR Q=316 TO 319
  233. 5060  LINE(Q,0)-(Q,199),3
  234. 5070  NEXT
  235. 5080  FOR Q=197 TO 199
  236. 5090  LINE(0,Q)-(319,Q),3
  237. 5100  NEXT
  238. 5110  FOR X=79 TO 0 STEP -N
  239. 5120  LINE(X,0)-(39,33),3
  240. 5130  NEXT
  241. 5140  FOR Y=0 TO 67 STEP N
  242. 5150  LINE(0,Y)-(39,33),3
  243. 5160  NEXT
  244. 5170  FOR X=0 TO 79 STEP N
  245. 5180  LINE(X,67)-(39,33),3
  246. 5190  NEXT
  247. 5200  FOR Y=67 TO 0 STEP -N
  248. 5210  LINE(79,Y)-(39,33),3
  249. 5220  NEXT
  250. 5230  GET(0,0)-(78,66),C
  251. 5240  PUT( 79,  0),C,PRESET
  252. 5250  PUT(157,  0),C,PSET
  253. 5260  PUT(235,  0),C,PRESET
  254. 5270  PUT(  0, 67),C,PRESET
  255. 5280  PUT( 79, 67),C,PSET
  256. 5290  PUT(157, 67),C,PRESET
  257. 5300  PUT(235, 67),C,PSET
  258. 5310  PUT(  0,133),C,PSET
  259. 5320  PUT( 79,133),C,PRESET
  260. 5330  PUT(157,133),C,PSET
  261. 5340  PUT(235,133),C,PRESET
  262. 5350  NEXT
  263. 5360  FOR A=0 TO 319 STEP 5
  264. 5370  LINE(  A,  0)-(159, 99),2
  265. 5380  NEXT
  266. 5390  FOR A=0 TO 199 STEP 5
  267. 5400  LINE(319,  A)-(159, 99),2
  268. 5410  NEXT
  269. 5420  FOR A=319 TO 0 STEP -5
  270. 5430  LINE(  A,199)-(159, 99),2
  271. 5440  NEXT
  272. 5450  FOR A=199 TO 0 STEP -5
  273. 5460  LINE(  0,  A)-(159, 99),2
  274. 5470  NEXT
  275. 5480  FOR A=1 TO 318 STEP 5
  276. 5490  LINE(  A,  0)-(159, 99),0
  277. 5500  NEXT
  278. 5510  FOR A=1 TO 198 STEP 5
  279. 5520  LINE(319,  A)-(159, 99),0
  280. 5530  NEXT
  281. 5540  FOR A=318 TO 1 STEP -5
  282. 5550  LINE(  A,199)-(159, 99),0
  283. 5560  NEXT
  284. 5570  FOR A=199 TO 1 STEP -5
  285. 5580  LINE(  0,  A)-(159, 99),0
  286. 5590  NEXT
  287. 5600  FOR A=1 TO 130 STEP 3
  288. 5610  CIRCLE(159,99),A,2
  289. 5620  NEXT
  290. 5630  FOR B=0 TO 99
  291. 5640  LINE(159,99-B)-(159+B,99),0
  292. 5650  LINE -(159, 99+B),0
  293. 5660  LINE -(159-B,99 ),0
  294. 5670  LINE -(159, 99-B),0
  295. 5680  CIRCLE(159,99),B/2,1
  296. 5690  NEXT
  297. 5695  NEXT
  298. 5700  GOSUB 1600
  299. 5710  IF I$="x" OR I$="X" THEN 40 ELSE IF I$=" " THEN 5000 ELSE IF I$="0" THEN N=10:GOTO 50
  300. 5720  N=VAL(I$):IF N>=0 AND N<14 THEN 50 ELSE 5000
  301. 5800  M=RND(1)*1000 MOD 8 + 1
  302. 5810  GOSUB 7000
  303. 5820  GOSUB 6000
  304. 5890  GOSUB 1600
  305. 5900  IF I$="x" OR I$="X" THEN 40 ELSE IF I$=" " THEN 5810 ELSE IF I$="0" THEN N=10:GOTO 50
  306. 5910  N=VAL(I$):IF N>=0 AND N<14 THEN 50 ELSE 5810
  307. 6000  D=D/57.2958
  308. 6005  CLS:XA=159:YA=99
  309. 6010  R=0
  310. 6020  X=R*COS(R)*A+159:Y=R*SIN(R)*B+99
  311. 6030  XP=X+OF:YP=Y:OF=OF+DO
  312. 6040  IF XP<0 OR XP>319 OR YP<0 OR YP> 199 THEN 6110
  313. 6050  IF S$="d" OR S$="D" THEN 6090 ELSE IF S$="b" OR S$="B" THEN 6070 ELSE IF S$="c" OR S$="C" THEN 6080
  314. 6060  LINE(XA,YA)-(XP,YP),CO3:GOTO 6100
  315. 6070  LINE(XA,YA)-(XP,YP),CO3,B:GOTO 6100
  316. 6080  CIRCLE(XP,YP),5,CO3:GOTO 6100
  317. 6090  PSET(XP,YP),CO3
  318. 6100  XA=X:YA=Y:R=R+D:GOTO 6020
  319. 6110  RETURN
  320. 7000  IF M=1 THEN D=73:S$="L":OF=0:DO=0:A=0.6:B=0.4:RETURN
  321. 7010  IF M=2 THEN D=183:S$="L":OF=0:DO=0.3:A=0.3:B=0.2:RETURN
  322. 7020  IF M=3 THEN D=357.8:S$="L":OF=0:DO=0.4:A=0.05:B=0.05:RETURN
  323. 7030  IF M=4 THEN D=45.1:S$="L":OF=0:DO=0.3:A=0.3:B=0.3:RETURN
  324. 7040  IF M=5 THEN D=44.9:S$="B":OF=0:DO=0:A=0.6:B=0.6:RETURN
  325. 7050  IF M=6 THEN D=33:S$="B":OF=0:DO=0:A=0.4:B=0.4:RETURN
  326. 7060  IF M=7 THEN D=180.5:S$="B":OF=0:DO=0:A=0.4:B=0.4:RETURN
  327. 7070  D=91:S$="L":OF=0:DO=0:A=0.5:B=0.5
  328. 7100  RETURN
  329. 8000  KEY (9) ON:KEY (10) ON:KEY(11) ON
  330. 8002  FOR X% = 1 TO 8: KEY (X%) ON: ON KEY (X%) GOSUB 9000:NEXT X%
  331. 8005  ON KEY (9) GOSUB 3700:ON KEY (10) GOSUB 3000:ON KEY(11) GOSUB 3900
  332. 8010  DIM A(50),B(50),C(350)
  333. 8014  KEY OFF:CLS
  334. 8015  TOG=2:GOSUB 65010:SCREEN 0,1
  335. 8020  SCREEN 0,1:HSYNC%=45
  336. 8025  RNDGEN=VAL(RIGHT$(TIME$,2))+VAL(MID$(TIME$,4,2))*12:ALT=0
  337. 8026  GOSUB 40000:GOSUB 30000
  338. 8030  RETURN
  339. 9000  REM Dummy Function keys
  340. 9010  BEEP
  341. 9020  RETURN
  342. 10000  REM menu
  343. 10010  SCREEN 0,1,0,0:COLOR 15,1,1:CLS:OUT 980,2:OUT 981,HSYNC%
  344. 10020  IF ALT=0 THEN COLOR 0,7 ELSE IF ALT=1 THEN COLOR 7,0
  345. 10025  LOCATE 3,8,0
  346. 10030  PRINT CHR$(16);" IBM PC LINE PATTERNS "; CHR$(17):PRINT
  347. 10040  COLOR  0,1
  348. 10050  PRINT "*** Press X to return to this Menu ***"
  349. 10060  PRINT "   Function Keys 1 to 10 are active."
  350. 10065  PRINT
  351. 10070  COLOR 15,1
  352. 10080  PRINT "        1 - Circle and Circle."
  353. 10090  PRINT "        2 - Moire Pattern."
  354. 10100  PRINT "        3 - Spiral."
  355. 10110  PRINT "        4 - Rotating Squares."
  356. 10120  PRINT "        5 - N-Sided Polygon."
  357. 10130  PRINT "        6 - Square Spiral."
  358. 10140  PRINT "        7 - Four Leaf Rose."
  359. 10150  PRINT "        8 - Outside Triangle Spiral."
  360. 10160  PRINT "        9 - Inside Triangle Spiral."
  361. 10165  PRINT "        0 - Big Eye."
  362. 10170  PRINT "        - - Multiple Pattern."
  363. 10175  PRINT "        = - Spirographs."
  364. 10180  PRINT "  Keys  Q thru I are more Spirographs."
  365. 10185  COLOR 23,1
  366. 10190  PRINT :PRINT "PRESS a key, C for Colors, or M to end?"
  367. 10200  RETURN
  368. 20000  SCREEN 1,0:COLOR 0,1
  369. 20010  PRINT "****  COLOR CONTROL COMMAND MENU  ****"
  370. 20020  PRINT
  371. 20030  PRINT "       PRESS F10 and a letter:"
  372. 20040  PRINT
  373. 20050  PRINT " B = Black   U = Blue    G = Green"
  374. 20060  PRINT " C = Cyan    R = Red     M = Magenta"
  375. 20070  PRINT " N = Brown   W = White   S = Light Blue"
  376. 20080  PRINT " Y = Yellow  H = High Intensity White"
  377. 20090  PRINT
  378. 20100  PRINT "     Or PRESS F10 and a number:
  379. 20110  PRINT
  380. 20120  PRINT "   0 = Palette 0    9 = Palette 1
  381. 20130  PRINT
  382. 20140  PRINT "       Depending on Palette:"
  383. 20150  PRINT
  384. 20160  PRINT "    Green   =   1   =     Cyan"
  385. 20170  PRINT "     Red    =   2   =    Magenta"
  386. 20180  PRINT "    Brown   =   3   =     White"
  387. 20190  PRINT
  388. 20200  PRINT " PRESS RETURN TO CONTINUE OR TRY F10!"
  389. 20202  PRINT "       ";STRING$(6,19)
  390. 20205  FOR Z=0 TO 20000
  391. 20210  I$=INKEY$:IF I$=CHR$(13) THEN Z=20000
  392. 20220  NEXT
  393. 20230  RETURN
  394. 29000  REM move screen left
  395. 29010  HSYNC%=HSYNC%+1:IF HSYNC% > 46 THEN BEEP:HSYNC%=46
  396. 29020  OUT 980,2:OUT 981,HSYNC%
  397. 29030  RETURN
  398. 29100  REM move screen right
  399. 29110  HSYNC%=HSYNC%-1:IF HSYNC% < 36 THEN BEEP:HSYNC%=36
  400. 29120  OUT 980,2:OUT 981,HSYNC%
  401. 29130  RETURN
  402. 30000  CLS
  403. 30020  SCREEN 0,1:COLOR 3,0:OUT 980,2:OUT 981,HSYNC%
  404. 30050  PRINT "This program will run unattended all "
  405. 30060  PRINT "by itself, or it can be shifted into "
  406. 30070  PRINT "manual operation by pressing ";:COLOR 12,0:PRINT "ALT A";:COLOR 3,0
  407. 30080  PRINT "at the menu screen. ";:COLOR 5,0:PRINT "In this mode, to"
  408. 30090  PRINT "procede with the next design press ";:COLOR 12,0:PRINT "F9.":COLOR 3,0
  409. 30110  PRINT "Pressing ";:COLOR 12,0:PRINT "ALT A";:COLOR 3,0:PRINT " again will return the"
  410. 30120  PRINT "program to auto operation.
  411. 30130  PRINT :COLOR 2,0
  412. 30140  PRINT "During any mode the top row of"
  413. 30150  PRINT "keys, from ";:COLOR 12,0:PRINT "1";:COLOR 2,0:PRINT " to ";:COLOR 12,0:PRINT "=";:COLOR 2,0:PRINT ", will call a design,"
  414. 30160  PRINT "as will ";:COLOR 12,0:PRINT "Q";:COLOR 2,0:PRINT " to ";:COLOR 12,0:PRINT "I";:COLOR 2,0:PRINT ". If nothing is done"
  415. 30170  PRINT "after about 10 seconds, the program"
  416. 30180  PRINT "will pick a design for you."
  417. 30190  COLOR 4,0:PRINT "RETURN";:COLOR 2,0:PRINT " is NOT needed for most input.";
  418. 30200  PRINT "Color backgrounds and palettes can be"
  419. 30210  PRINT "changed during operation. Press ";:COLOR 12,0:PRINT "C";:COLOR 2,0:PRINT
  420. 30220  PRINT "at the menu prompt for an explantion."
  421. 30230  PRINT :COLOR 6,0
  422. 30240  PRINT "Hitting the ";:COLOR 4,0:PRINT "SPACE";:COLOR 6,0:PRINT " bar repeats a design"
  423. 30250  PRINT "with a different color. Entering a"
  424. 30260  PRINT "series of keys results in a series of"
  425. 30270  PRINT "designs, but they come on top of each"
  426. 30280  PRINT "other. Press ";:COLOR 4,0:PRINT "UP ARROW";:COLOR 6,0:PRINT " to clear buffer."
  427. 30290  LOCATE 25,1:INPUT "   Press RETURN to continue";I$:RETURN
  428. 30295  FOR GEN%=1 TO 32766
  429. 30296  RNDGEN%=GEN%:I$=INKEY$
  430. 30297  IF I$ <> ""  THEN GEN%=32766:X%=1
  431. 30298  NEXT GEN%
  432. 30299  Y=FRE(X$):IF X% <> 1 THEN 30295
  433. 30300  RANDOMIZE RNDGEN%
  434. 30310  RETURN
  435. 30311  X=X+1
  436. 30312  X=X-1
  437. 30313  I$=INKEY$
  438. 30314  IF I$=CHR$(13) THEN 30320
  439. 30315  X=FRE(X$)
  440. 30316  GOTO 30311
  441. 30320  KEY(12) OFF:KEY(13) OFF:SCREEN 1,0:OUT 980,0:OUT 981,HSYNC%:RETURN
  442. 40000  LOCATE 11,9:PRINT "IBM LINE PATTERNS PROGRAM":COLOR 22,0:LOCATE 15,16:PRINT "Press RETURN":COLOR 0,7:GOSUB 30295
  443. 40005  KEY(12) ON:KEY(13) ON:ON KEY(12) GOSUB 29000:ON KEY(13) GOSUB 29100:REM    Center Screen
  444. 40010  SCREEN 0,1:COLOR 7,1,4:CLS
  445. 40055  COLOR 7,1
  446. 40060  LOCATE  7, 8:PRINT "If this is not centered";
  447. 40070  LOCATE 10, 8:PRINT "on your screen, use the";
  448. 40080  LOCATE 13,13:PRINT "left and right";
  449. 40085  LOCATE 16, 8:PRINT "arrow keys to center it.";
  450. 40088  COLOR 31,1:LOCATE 19,14:PRINT "PRESS RETURN";:COLOR 7,1
  451. 40090  GOSUB 40400:RETURN
  452. 40400  X=X+1
  453. 40410  X=X-1
  454. 40420  I$=INKEY$
  455. 40430  IF I$=CHR$(13) THEN 40460
  456. 40440  X=FRE(X$)
  457. 40450  GOTO 40400
  458. 40460  KEY(12) OFF:KEY(13) OFF:SCREEN 1,0:RETURN
  459. 65000  IF TOG=1 THEN TOG=2 ELSE TOG=1
  460. 65010  ON TOG GOSUB 65080, 65030
  461. 65020  RETURN
  462. 65030  REM toggle color graphics
  463. 65050  DEF SEG=0: A=PEEK(&H410): POKE &H410,(A AND &HCF) OR &H20
  464. 65060  WIDTH 40:SCREEN 1:SCREEN 0:LOCATE ,,1,6,7: SCREEN 1,0
  465. 65070  RETURN
  466. 65080  REM toggle monochrome display
  467. 65100  DEF SEG=0: A=PEEK(&H410): POKE &H410,A OR &H30
  468. 65110  WIDTH 80: LOCATE ,,1,12,13:SCREEN 0,0,0
  469. 65120  RETURN
  470.